home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d3 / db4less3.arc / CUSTMENU.PRG < prev    next >
Text File  |  1990-06-16  |  3KB  |  144 lines
  1. **********************************************************************
  2. * Program......: CUSTMENU.PRG
  3. * Author.......:          This is an APPLICATION OBJECT.
  4. * Date.........: 12-04-88
  5. * Notice.......: Type information here or greetings to your users.
  6. * dBASE Ver....: See Application menu to use as sign-on banner.
  7. * Generated by.: APGEN version 1.0
  8. * Description..: Customer Menu Class Example
  9.  
  10. * Description..: Menu actions
  11. **********************************************************************
  12. PROCEDURE CUSTMENU
  13. PARAMETER entryflg
  14. PRIVATE gc_prognum
  15. gc_prognum="01"
  16.  
  17. DO SET01
  18. IF gn_error > 0
  19.    gn_error=0
  20.    RETURN
  21. ENDIF
  22.  
  23. *-- Before menu code
  24.  
  25.  
  26. ACTIVATE MENU CUSTMENU
  27.  
  28. @ 1,0 CLEAR TO 3,79
  29.  
  30. *-- After menu
  31.  
  32. RETURN
  33. *-- EOP CUSTMENU
  34.  
  35. PROCEDURE SET01
  36. ON KEY LABEL F1 DO 1HELP1
  37.  
  38. DO DBF01 && open menu level database
  39.  
  40. IF gn_error = 0
  41.    IF ISCOLOR()
  42.       SET COLOR OF NORMAL TO W+/B
  43.       SET COLOR OF MESSAGES TO W+/B
  44.       SET COLOR OF TITLES TO W+/B
  45.       SET COLOR OF HIGHLIGHT TO B/W
  46.       SET COLOR OF BOX TO B/W
  47.       SET COLOR OF INFORMATION TO B/W
  48.       SET COLOR OF FIELDS TO B/W
  49.    ENDIF
  50.  
  51.    SET BORDER TO
  52.    @ 1,0 TO 3,79 DOUBLE COLOR B/W
  53.    @ 2,1 CLEAR TO 2,78
  54.    @ 2,1 FILL TO 2,78 COLOR W+/B
  55.    @ 2,10 SAY "ADD" COLOR W+/B
  56.    @ 2,22 SAY "CHANGE" COLOR W+/B
  57.    @ 2,38 SAY "REPORT" COLOR W+/B
  58.    @ 2,69 SAY "EXIT" COLOR W+/B
  59.    @ 22,00
  60. ENDIF
  61. RETURN
  62.  
  63. PROCEDURE DBF01
  64. CLOSE DATABASES
  65. *-- Open menu level view/database
  66. lc_message="0"
  67. ON ERROR lc_message=LTRIM(STR(ERROR()))+" "+MESSAGE()
  68. USE CUSTOMER
  69. SET ORDER TO CUSTNAME
  70. ON ERROR
  71. gn_error=VAL(lc_message)
  72. IF gn_error > 0
  73.    DO Pause WITH ;
  74.    "Error opening CUSTOMER.DBF"
  75.    lc_new='Y'
  76.    RETURN
  77. ENDIF
  78. lc_new='Y'
  79. RELEASE lc_message
  80. RETURN
  81.  
  82. PROCEDURE ACT01
  83. *-- Begin CUSTMENU: BAR Menu Actions.
  84. *-- (before item, action, and after item)
  85. *
  86. PRIVATE lc_new, lc_dbf
  87. lc_new=' '
  88. lc_dbf=' '
  89. DO CASE
  90. CASE "PAD_1" = PAD()
  91.    ACTIVATE WINDOW Browscr
  92.    SET SCOREBOARD ON
  93.    *-- Desc: attach format file CUSTOMER
  94.    SET FORMAT TO CUSTOMER
  95.    APPEND
  96.  
  97.    *-- close format file so as not to affect READ's
  98.    SET FORMAT TO
  99.    SET SCOREBOARD OFF
  100.    DEACTIVATE WINDOW Browscr
  101. CASE "PAD_2" = PAD()
  102.    ACTIVATE WINDOW Browscr
  103.    SET SCOREBOARD ON
  104.    *-- Desc: attach format file CUSTOMER
  105.    SET FORMAT TO CUSTOMER
  106.    EDIT NOAPPEND 
  107.    *-- close format file so as not to affect READ's
  108.    SET FORMAT TO
  109.    SET SCOREBOARD OFF
  110.    DEACTIVATE WINDOW Browscr
  111. CASE "PAD_3" = PAD()
  112.    ACTIVATE WINDOW Savescr
  113.    *-- Desc: Report
  114.    gn_pkey = 0
  115.    DO PrintSet
  116.    IF gn_pkey <> 27  && esc
  117.       REPORT FORM CUSTOMER PLAIN  NOEJECT 
  118.       DO Cleanup
  119.    ENDIF
  120.    DEACTIVATE WINDOW Savescr
  121. CASE "PAD_4" = PAD()
  122.    *-- Return to caller
  123.    gc_quit='Q'
  124.    DEACTIVATE MENU && CUSTMENU
  125.    RETURN
  126. OTHERWISE
  127.    @ 24,00
  128.    @ 24,21 SAY "This item has no action. Press a key."
  129.    x=INKEY(0)
  130.    @ 24,00
  131. ENDCASE
  132. SET MESSAGE TO
  133. IF SET("STATUS")="ON"
  134.    SET STATUS OFF
  135. ENDIF
  136. IF gc_quit='Q'
  137.    DEACTIVATE MENU && CUSTMENU
  138. ENDIF
  139. IF lc_new='Y'
  140.    lc_file="SET"+gc_prognum
  141.    DO &lc_file.
  142. ENDIF
  143. RETURN
  144.